home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 501-525 / disk_518 / post / post16s.lzh / postint.c < prev    next >
Text File  |  1991-04-17  |  60KB  |  2,120 lines
  1. /* PostScript interpreter file "postint.c" - the basic interpreter */
  2. /* (C) Adrian Aylward 1989, 1991 */
  3.  
  4. # include "post.h"
  5.  
  6. /* Initialise the interpreter */
  7.  
  8. void initint(int parms)
  9. {   struct object token, *aptr;
  10.     int i;
  11.  
  12.     /* Initialise the virtual machine */
  13.  
  14.     vminit(parms);
  15.  
  16.     /* Initialise the basic interpreter */
  17.  
  18.     inest = 0;
  19.     istate.flags = 0;
  20.     istate.type = -1;
  21.     istate.vmbase = 0;
  22.     istate.gbase = 0;
  23.     istate.execbase = 0;
  24.     istate.pfcrec = NULL;
  25.     istack = vmallocv(sizeof (struct istate) * istacksize);
  26.     strncpy(prompt1, "> ", promptsize);
  27.     strncpy(prompt2, "- ", promptsize);
  28.     time(&time1);
  29.     random = 1;
  30.     nametable = vmallocv(sizeof (vmref) * nametablesize);
  31.     opernest = 0;
  32.     execnest = 0;
  33.     dictnest = 0;
  34.     operstack = vmallocv(sizeof (struct object) * operstacksize);
  35.     execstack = vmallocv(sizeof (struct object) * execstacksize);
  36.     dictstack = vmallocv(sizeof (struct object) * dictstacksize);
  37.     filetable = vmallocv(sizeof (struct file) * filetablesize);
  38.     filetable[0].ch = '\n';
  39.     filetable[0].open = openread;
  40.     filetable[0].fptr = sstdin;
  41.     filetable[1].ch = EOF;
  42.     filetable[1].open = openwrite;
  43.     filetable[1].fptr = sstdout;
  44.     filetable[2].ch = EOF;
  45.     filetable[2].open = openwrite;
  46.     filetable[2].fptr = sstderr;
  47.     optable = vmallocv(sizeof (struct operator) * (optablesize + 1));
  48.     opnum = 0;
  49.  
  50.     /* Initialise the dictionaries */
  51.  
  52.     dicttoken(&dictstack[0], systemdictsize);
  53.     systemname(&dictstack[0], "systemdict", 0);
  54.     dicttoken(&dictstack[1], userdictsize);
  55.     systemname(&dictstack[1], "userdict", 0);
  56.     dictnest = 2;
  57.     token.type = typestring;
  58.     token.flags = flagwprot;
  59.     token.length = strlen(version);
  60.     token.value.vref = vmalloc(token.length);
  61.     memcpy(vmsptr(token.value.vref), version, token.length);
  62.     systemname(&token, "version", 0);
  63.     token.type = typebool;
  64.     token.flags = 0;
  65.     token.length = 0;
  66.     token.value.ival = 0;
  67.     systemname(&token, "false", 0);
  68.     token.value.ival = 1;
  69.     systemname(&token, "true", 0);
  70.     token.type = typeint;
  71.     token.flags = 0;
  72.     token.length = 0;
  73.     token.value.ival = 1;
  74.     nametoken(&copies, "#copies", -1, 0);
  75.     dictput(dictstack[1].value.vref, &copies, &token);
  76.  
  77.     /* Initialise the operators */
  78.  
  79.     initop1();
  80.     initop2();
  81.     initop3();
  82.     initop4();
  83.  
  84.     /* Initialise "errordict" */
  85.  
  86.     dicttoken(&errordict, errordictsize);
  87.     systemname(&errordict, "errordict", 0);
  88.     token.type = typeoper;
  89.     token.flags = flagexec;
  90.     token.length = 0;
  91.     token.value.ival = 1;
  92.     for (i = 0; i <= errmax; i++)
  93.     {   nametoken(&errorname[i], errortable[i], -1, flagexec);
  94.         dictput(errordict.value.vref, &errorname[i], &token);
  95.         token.value.ival = 0;
  96.     }
  97.  
  98.     /* The value of "handleerror" in "systemdict" is
  99.      *              "errordict /handleerror get exec" */
  100.  
  101.     token.type = typearray;
  102.     token.flags = flagexec;
  103.     token.length = 4;
  104.     token.value.vref = arrayalloc(4);
  105.     aptr = vmaptr(token.value.vref);
  106.     aptr[0] = errordict;
  107.     aptr[1] = errorname[0];
  108.     aptr[1].flags = 0;
  109.     nametoken(&aptr[2], "get", -1, flagexec);
  110.     nametoken(&aptr[3], "exec", -1, flagexec);
  111.     bind(&token, 0);
  112.     dictput(dictstack[0].value.vref, &errorname[0], &token);
  113.  
  114.     /* Initialise "$error" */
  115.  
  116.     dicttoken(&errdsdict, errdsdictsize);
  117.     nametoken(&token, "$error", -1, 0);
  118.     dictput(dictstack[0].value.vref, &token, &errdsdict);
  119.     token.type = typebool;
  120.     token.flags = 0;
  121.     token.length = 0;
  122.     token.value.ival = 0;
  123.     for (i = 0; i < edsmax; i++)
  124.     {   nametoken(&errdsname[i], errdstable[i], -1, flagexec);
  125.         errdstoken[i] = token;
  126.         dictput(errdsdict.value.vref, &errdsname[i], &token);
  127.         token.type = typenull;
  128.     }
  129.  
  130.     /* Initialise the graphics state, character routines */
  131.  
  132.     initgstate();
  133.     initchar();
  134. }
  135.  
  136. /* Tidy up the interpreter */
  137.  
  138. void tidyint()
  139. {   struct file *file;
  140.     int filenum;
  141.  
  142.     /* Close all opened files */
  143.  
  144.     if (filetable)
  145.     {   for (filenum = 3; filenum < filetablesize; filenum++)
  146.         {   file = &filetable[filenum];
  147.             if (file->open != 0) fclose(file->fptr);
  148.         }
  149.         filetable = (struct file *) 0;
  150.     }
  151.  
  152.     /* Tidy up the virtual machine */
  153.  
  154.     vmtidy();
  155. }
  156.  
  157. /* Make a name and insert it into the system dictionary */
  158.  
  159. void systemname(struct object *token, char *sptr, int flags)
  160. {   struct object nameobj;
  161.     nametoken(&nameobj, sptr, -1, flags);
  162.     dictput(dictstack[0].value.vref, &nameobj, token);
  163. }
  164.  
  165. /* Make an operator and insert it into the system dictionary */
  166.  
  167. void systemop(void (*func)(), char *sptr)
  168. {   struct object token;
  169.     if (opnum  == optablesize) error(errlimitcheck);
  170.     optable[opnum].func = func;
  171.     optable[opnum].sptr = sptr;
  172.     token.type = typeoper;
  173.     token.flags = flagexec;
  174.     token.length = 0;
  175.     token.value.ival = opnum;
  176.     systemname(&token, sptr, flagexec);
  177.     opnum++;
  178. }
  179.  
  180. /* The interpreter */
  181.  
  182. void interpret(struct object *interpreting)
  183. {   struct object token, *executing, *savetoken;
  184.  
  185.     /* Start with a null token, in case we get an error before we have read
  186.      * one. */
  187.  
  188.     token.type = 0;
  189.     token.flags = 0;
  190.     token.value.ival = 0;
  191.  
  192.     /* Push the object we want to execute onto the execution stack.  Save the
  193.      * error jump buffer on the error stack.  Set up the current token. */
  194.  
  195.     if (execnest >= execstacksize) error(errexecstackoverflow);
  196.     execstack[execnest++] = *interpreting;
  197.     savetoken = currtoken;
  198.  
  199.     while (setjmp(istate.errjmp) != 0) continue;
  200.  
  201.     currtoken = &token;
  202.  
  203.     /* Loop until the execution stack is empty.  (I.e. the same level as it
  204.      * was when we entered.  Check for interrupt. */
  205.  
  206.     while (execnest != istate.execbase)
  207.     {   if (intsigflag != 0)
  208.         {   if (intsigflag == 1)
  209.             {   intsigflag = 0;
  210.                 error(errinterrupt);
  211.             }
  212.             else
  213.             {   intsigflag = 0;
  214.                 error(errkill);
  215.             }
  216.         }
  217.         executing = &execstack[execnest - 1];
  218.  
  219.         /* If the top of the stack is executable extract the next token from
  220.          * it. */
  221.  
  222.         if (executing->flags & flagexec)
  223.         {   if (executing->flags & flagxprot) error(errinvalidaccess);
  224.             if (executing->type == typearray)
  225.             {   if (executing->length == 0)
  226.                 {   execnest--;
  227.                     continue;
  228.                 }
  229.                 token = *vmaptr(executing->value.vref);
  230.                 executing->value.vref += sizeof (struct object);
  231.                 if (--executing->length == 0)
  232.                     execnest--;
  233.                 goto dir;
  234.             }
  235.             if (executing->type == typepacked)
  236.             {   if (executing->length == 0)
  237.                 {   execnest--;
  238.                     continue;
  239.                 }
  240.                 executing->value.vref +=
  241.                     unpack(&token, vmsptr(executing->value.vref));
  242.                 if (--executing->length == 0)
  243.                     execnest--;
  244.                 goto dir;
  245.             }
  246.             if (executing->type == typefile)
  247.             {   if (!scantoken(&token, executing, 0))
  248.                 {   if (filetable[executing->length].emode != 0)
  249.                     {   filetable[executing->length].emode = 0;
  250.                         if (dictnest < 3) error(errdictstackunderflow);
  251.                         dictnest--;
  252.                     }
  253.                     else
  254.                         fileclose(executing);
  255.                     execnest--;
  256.                     continue;
  257.                 }
  258.                 goto dir;
  259.             }
  260.             if (executing->type == typestring)
  261.             {   if (!scantoken(&token, executing, 0))
  262.                 {   execnest--;
  263.                     continue;
  264.                 }
  265.                 goto dir;
  266.             }
  267.         }
  268.  
  269.         /* Otherwise if it is a control operator execute it without popping
  270.          * the stack;  for all other cases we pop it off the stack and
  271.          * execute it. */
  272.  
  273.         token = *executing;
  274.         if (token.flags & flagctrl)
  275.         {   (*(optable[token.value.ival].func))();
  276.             continue;
  277.         }
  278.         execnest--;
  279.  
  280.         /* Execute an object obtained indirectly.  (Procedures are executed
  281.          * immediately.) */
  282.  
  283. ind:    if (token.flags & flagexec)
  284.         {   if      (token.type == typeoper)
  285.             {   (*(optable[token.value.ival].func))();
  286.                 continue;
  287.             }
  288.             else if (token.type == typename)
  289.             {   if (dictfind(&token, &token) == -1) error(errundefined);
  290.                 goto ind;
  291.             }
  292.             else
  293.             {   if (token.type == typenull) continue;
  294.                 if (execnest == execstacksize) error(errexecstackoverflow);
  295.                 execstack[execnest++] = token;
  296.                 continue;
  297.             }
  298.         }
  299.         if (opernest == operstacksize) error(errstackoverflow);
  300.         operstack[opernest++] = token;
  301.         continue;
  302.  
  303.         /* Execute an object obtained directly.  (Procedures are pushed onto
  304.          * the operand stack.) */
  305.  
  306. dir:    if (token.flags & flagexec)
  307.         {   if      (token.type == typeoper)
  308.             {   (*(optable[token.value.ival].func))();
  309.                 continue;
  310.             }
  311.             else if (token.type == typename)
  312.             {   if (dictfind(&token, &token) == -1) error(errundefined);
  313.                 goto ind;
  314.             }
  315.             else if (token.type != typearray && token.type != typepacked)
  316.             {   if (token.type == typenull) continue;
  317.                 if (execnest == execstacksize) error(errexecstackoverflow);
  318.                 execstack[execnest++] = token;
  319.                 continue;
  320.             }
  321.         }
  322.         if (opernest == operstacksize) error(errstackoverflow);
  323.         operstack[opernest++] = token;
  324.     }
  325.  
  326.     /* Restore the current token and exit to the next outer level. */
  327.  
  328.     currtoken = savetoken;
  329. }
  330.  
  331. /* Push the interpreter stack before recursing */
  332.  
  333. void pushint(void)
  334. {   if (inest == istacksize) error(errlimitcheck);
  335.     istack[inest++] = istate;
  336.     istate.flags = 0;
  337.     istate.type = -1;
  338.     istate.vmbase = vmnest;
  339.     istate.gbase = gnest;
  340.     istate.execbase = execnest;
  341.     istate.pfcrec = NULL;
  342. }
  343.  
  344. /* Pop the interpreter (and vm and graphics) stacks after recursing */
  345.  
  346. void popint(void)
  347. {   if (vmnest != istate.vmbase)
  348.         vmrest(istate.vmbase, -1);
  349.     if (gnest != istate.gbase)
  350.     {   gnest = istate.gbase + 1;
  351.         grest();
  352.     }
  353.     if (istate.pfcrec)
  354.         istate.pfcrec->count = 0;
  355.     istate = istack[--inest];
  356. }
  357.  
  358. /* Put a character on an output stream */
  359.  
  360. void putch(FILE *fptr, int ch)
  361. {   if (putc(ch, fptr) == EOF) error(errioerror);
  362. }
  363.  
  364. /* Put a string on an output stream */
  365.  
  366. void putstr(FILE *fptr, char *str)
  367. {   int ch;
  368.     while (ch = *str++)
  369.         if (putc(ch, fptr) == EOF) error(errioerror);
  370. }
  371.  
  372. /* Put a memory buffer on an output stream */
  373.  
  374. void putmem(FILE *fptr, char *sptr, int length)
  375. {   while (length--)
  376.         if (putc(*sptr++, fptr) == EOF) error(errioerror);
  377. }
  378.  
  379. /* Put a memory buffer on an output stream, checking for funny characters */
  380.  
  381. void putcheck(FILE *fptr, char *sptr, int length)
  382. {   int ch;
  383.     while (length--)
  384.     {   ch = *(unsigned char *)sptr++;
  385.         if (ch < 0x20 || ch >= 0x7f)
  386.         {   if      (ch == '\n')
  387.                 putstr(fptr, "\\n");
  388.             else if (ch == '\r')
  389.                 putstr(fptr, "\\r");
  390.             else if (ch == '\t')
  391.                 putstr(fptr, "\\t");
  392.             else if (ch == '\b')
  393.                 putstr(fptr, "\\b");
  394.             else if (ch == '\f')
  395.                 putstr(fptr, "\\f");
  396.             else
  397.                 if (fprintf(fptr, "\\%03.3o", ch) == EOF) error(errioerror);
  398.         }
  399.         else
  400.             if (putc(ch, fptr) == EOF) error(errioerror);
  401.     }
  402. }
  403.  
  404. /* Open a file */
  405.  
  406. void fileopen(struct object *token, int open, char *name, int length)
  407. {   struct file *file;
  408.     int filenum;
  409.     if (length < 0) length = strlen(name);
  410.     if (length > namebufsize) error(errlimitcheck);
  411.     memcpy(namebuf, name, length);
  412.     namebuf[length] = 0;
  413.     if (strlen(namebuf) != length) error(errrangecheck);
  414.     if      (strcmp(namebuf, "%stdin") == 0)
  415.         filenum = 0;
  416.     else if (strcmp(namebuf, "%stdout") == 0)
  417.         filenum = 1;
  418.     else if (strcmp(namebuf, "%stderr") == 0)
  419.         filenum = 2;
  420.     else
  421.     {   filenum = 3;
  422.         for (;;)
  423.         {   file = &filetable[filenum];
  424.             if (file->open == 0) break;
  425.             ++filenum;
  426.             if (filenum == filetablesize) error(errlimitcheck);
  427.         }
  428.     }
  429.     if (filenum < 3)
  430.     {   file = &filetable[filenum];
  431.         if (file->fptr == NULL) error(errundefinedfilename);
  432.         if (file->open != (open & ~openfont)) error(errinvalidfileaccess);
  433.     }
  434.     else
  435.     {   file->fptr = fopen(namebuf, ((open == openwrite) ? "w" : "r"));
  436.         if (file->fptr == NULL) error(errundefinedfilename);
  437.         file->open = open & ~openfont;
  438.         file->saved = vmnest;
  439.         file->ch = EOF;
  440.         file->uflg = 0;
  441.         file->slen = 0;
  442.         file->emode = 0;
  443.         file->erand = 0;
  444.         file->stype = 0;
  445.         if (open & openfont) file->stype = -1;
  446.     }
  447.     token->type = typefile;
  448.     token->flags = 0;
  449.     token->length = filenum;
  450.     token->value.ival = file->generation;
  451. }
  452.  
  453. /* Close a file */
  454.  
  455. void fileclose(struct object *token)
  456. {   struct file *file;
  457.     FILE *fptr;
  458.     int open;
  459.     if (token->length > 2)
  460.         if (file = filecheck(token, (openread | openwrite)))
  461.         {   fptr = file->fptr;
  462.             open = file->open;
  463.             file->fptr = NULL;
  464.             file->generation++;
  465.             file->open = 0;
  466.             if (fclose(fptr) == EOF)
  467.                 if (open & openwrite) error(errioerror);
  468.         }
  469. }
  470.  
  471. /* Check a file is open */
  472.  
  473. struct file *filecheck(struct object *token, int open)
  474. {   struct file *file;
  475.     file = &filetable[token->length];
  476.     if (file->generation == token->value.ival && (file->open & open) != 0)
  477.         return file;
  478.     else
  479.         return NULL;
  480. }
  481.  
  482. /* Get the next character from a file, allowing IBM font format */
  483.  
  484. # define getf(file,fptr) (--file->slen >= 0 ? getc(fptr) : getfseg(file))
  485.  
  486. /* Unget the last character from a file, allowing IBM font format */
  487.  
  488. # define ungetf(ch,file,fptr) (file->slen++, ungetc(ch, fptr))
  489.  
  490. /* Locate the next segment of an IBM font format file */
  491.  
  492. int getfseg(struct file *file)
  493. {   FILE *fptr;
  494.     int ch, i;
  495.     fptr = file->fptr;
  496.     file->slen = 0;
  497.  
  498.     /* Unknown file type; assume IBM font if first character is 0x80 */
  499.  
  500.     if (file->stype == -1)
  501.     {   ch = getc(fptr);
  502.         if (ch == EOF) error(errioerror);
  503.         ungetc(ch, fptr);
  504.         if (ch != 0x80) file->stype = 0;
  505.     }
  506.  
  507.     /* Standard file; may come here after reading 2 Gigabytes? */
  508.  
  509.     if (file->stype == 0)
  510.     {   file->slen = 0x7fffffff;
  511.         return getc(fptr);
  512.     }
  513.  
  514.     /* IBM font format.  Read 6 byte segment header */
  515.  
  516. gets:
  517.     ch = getc(fptr);
  518.     if (ch != 0x80)
  519.     {  if (ch != EOF || ferror(fptr)) error(errioerror);
  520.        return EOF;
  521.     }
  522.     ch = getc(fptr);
  523.     file->stype = ch;
  524.     if      (ch == 1 || ch == 2)
  525.     {   file->stype = ch;
  526.         i = 4;
  527.         while (i--)
  528.         {   ch = getc(fptr);
  529.             if (ch == EOF) error(errioerror);
  530.             file->slen = (((unsigned) file->slen) >> 8) | (ch << 24);
  531.         }
  532.     }
  533.     else if (ch != 3)
  534.         error(errioerror);
  535.     if (--file->slen <= 0) goto gets;
  536.     return getc(fptr);
  537. }
  538.  
  539. /* Initialise a file for decryption */
  540.  
  541. void fileeinit(struct object *token)
  542. {   struct file *file;
  543.     FILE *fptr;
  544.     int digit[4], i, j, k, ch, dig, num;
  545.  
  546.     file = filecheck(token, openread | openwrite);
  547.     if (file == NULL) error(errioerror);
  548.     fptr = file->fptr;
  549.  
  550.     /* Skip white space characters, except for IBM binary sections */
  551.  
  552.     ch = getf(file, fptr);
  553.     if (file->stype != 2)
  554.         while (ch == ' ' || ch == '\t' || ch == '\r' || ch == '\n')
  555.             getf(file, fptr);
  556.     ungetf(ch, file, fptr);
  557.  
  558.     /* Decrypt four binary bytes, checking whether they are all hex digits */
  559.  
  560.     file->erand = einitexec;
  561.     file->emode = 2;
  562.     for (i = 0; i < 4; i++)
  563.     {   ch = getf(file, fptr);
  564.         if (ch == EOF)
  565.         {   if (ferror(fptr)) error(errioerror);
  566.             error(errsyntaxerror);
  567.         }
  568.         if ((digit[i] = digitval(ch)) >= 16) file->emode = 1;
  569.         file->erand = ((file->erand + ch) * ec1 + ec2) & emask;
  570.     }
  571.  
  572.     /* If all hex, must be hex encryption.  So decrypt four hex bytes */
  573.  
  574.     if (file->emode == 2)
  575.     {   file->erand = einitexec;
  576.         j = 0;
  577.         for (k = 0; k < 4; k++)
  578.         {   if (j < i)
  579.             {   num = digit[j];
  580.                 j++;
  581.             }
  582.             else
  583.             {   ch = getf(file, fptr);
  584.                 if (ch == EOF && ferror(fptr)) error(errioerror);
  585.                 if ((num = digitval(ch)) >= 16) error(errsyntaxerror);
  586.             }
  587.             if (j < i)
  588.             {   dig = digit[j];
  589.                 j++;
  590.             }
  591.             else
  592.             {   ch = getf(file, fptr);
  593.                 if (ch == EOF && ferror(fptr)) error(errioerror);
  594.                 if ((dig = digitval(ch)) >= 16) error(errsyntaxerror);
  595.             }
  596.             ch = (num << 4) + dig;
  597.             file->erand = ((file->erand + ch) * ec1 + ec2) & emask;
  598.         }
  599.     }
  600. }
  601.  
  602. /* Read a character from a file or string */
  603.  
  604. int readch(struct object *input, int depth)
  605. {   struct file *file;
  606.     FILE *fptr;
  607.     int ch, cx, num, dig;
  608.     if (input->type == typefile)
  609.     {   file = &filetable[input->length];
  610.         if (file->uflg)
  611.         {   file->uflg = 0;
  612.             return file->ch;
  613.         }
  614.         fptr = file->fptr;
  615.  
  616.         /* Not encrypted */
  617.  
  618.         if (file->emode == 0)
  619.         {   if (file->ch == '\n' && fptr == sstdin && prompting)
  620.             {   if (intsigflag)
  621.                 {   intsigflag = 0;
  622.                     currtoken->type = 0;
  623.                     currtoken->flags = 0;
  624.                     currtoken->value.ival = 0;
  625.                     error(errinterrupt);
  626.                 }
  627.                 if (depth >= 0)
  628.                     fputs(((depth == 0) ? prompt1: prompt2), sstdout);
  629.             }
  630.             ch = getf(file, fptr);
  631.             if (ch == '\r' && depth != -2)
  632.             {   ch = getf(file, fptr);
  633.                 if (ch != '\n')
  634.                 {   ungetf(ch, file, fptr);
  635.                     ch = '\n';
  636.                 }
  637.             }
  638.             if (ch == EOF && ferror(fptr)) error(errioerror);
  639.         }
  640.  
  641.         /* Encrypted */
  642.  
  643.         else
  644.         {
  645.             /* Binary */
  646.  
  647.             if      (file->emode == 1)
  648.             {   cx = getf(file, fptr);
  649.                 if (cx == EOF)
  650.                 {   if (ferror(fptr)) error(errioerror);
  651.                     error(errsyntaxerror);
  652.                 }
  653.             }
  654.  
  655.             /* Hex */
  656.  
  657.             else if (file->emode == 2)
  658.             {   do  ch = getf(file, fptr);
  659.                     while (ch == ' ' || ch == '\t' ||
  660.                            ch == '\r' || ch == '\n');
  661.                 if ((num = digitval(ch)) >= 16)
  662.                 {   if (ch == EOF && ferror(fptr)) error(errioerror);
  663.                     error(errsyntaxerror);
  664.                 }
  665.                 do  ch = getf(file, fptr);
  666.                     while (ch == ' ' || ch == '\t' ||
  667.                            ch == '\r' || ch == '\n');
  668.                 if ((dig = digitval(ch)) >= 16)
  669.                 {   if (ch == EOF && ferror(fptr)) error(errioerror);
  670.                     error(errsyntaxerror);
  671.                 }
  672.                 cx = (num << 4) + dig;
  673.             }
  674.  
  675.             /* End of encryption */
  676.  
  677.             else
  678.             {   file->ch = EOF;
  679.                 return EOF;
  680.             }
  681.  
  682.             /* Decrypt */
  683.  
  684.             ch = cx ^ (file->erand >> eshift);
  685.             file->erand = ((file->erand + cx) * ec1 + ec2) & emask;
  686.             if (ch == '\r' && depth != -2)
  687.                 ch = '\n';
  688.         }
  689.  
  690.         file->ch = ch;
  691.         return ch;
  692.     }
  693.     else
  694.     {   if (input->length == 0)
  695.             return EOF;
  696.         else
  697.         {   input->length--;
  698.             ch = *((unsigned char *) (vmsptr(input->value.vref)));
  699.             input->value.vref++;
  700.             return ch;
  701.         }
  702.     }
  703. }
  704.  
  705. /* Unread a character from a file or string */
  706.  
  707. void unreadch(struct object *input, int ch)
  708. {   if (input->type == typefile)
  709.         filetable[input->length].uflg = 1;
  710.     else
  711.         if (ch != EOF)
  712.         {   input->length++;
  713.             input->value.vref--;
  714.         }
  715. }
  716.  
  717. /* If a character is a digit return its value */
  718.  
  719. int digitval(int ch)
  720. {   if (ch >= '0' && ch <= '9') return ch - '0';
  721.     if (ch >= 'A' && ch <= 'Z') return ch - 'A' + 10;
  722.     if (ch >= 'a' && ch <= 'z') return ch - 'a' + 10;
  723.     return 99;
  724. }
  725.  
  726. /* Scan a file or string for an object token */
  727.  
  728. int scantoken(struct object *token, struct object *input, int depth)
  729. {   int ch, num, dig, length, nest, flags, load;
  730.  
  731.     if (input->type == typefile)
  732.         if (filecheck(input, openread) == NULL) error(errioerror);
  733.     if (input->flags & flagxprot) error(errinvalidaccess);
  734.  
  735. lab:
  736.     ch = readch(input, depth);
  737.     switch (ch)
  738.     {   case EOF:
  739.             return 0;
  740.  
  741.         case ' ': case '\t': case '\n':
  742.             goto lab;
  743.  
  744.         case '%':
  745.             for (;;)
  746.             {   ch = readch(input, depth);
  747.                 if (ch == EOF) return 0;
  748.                 if (ch == '\n') goto lab;
  749.             }
  750.  
  751.         case ')': case '>':
  752.             error(errsyntaxerror);
  753.  
  754.         case '(':
  755.             length = 0;
  756.             nest = 1;
  757.             for (;;)
  758.             {   ch = readch(input, -1);
  759.                 if (ch == EOF) error(errsyntaxerror);
  760.                 if (ch == '(') nest++;
  761.                 if (ch == ')' && --nest == 0) break;
  762.                 if (ch == '\\')
  763.                 {   ch = readch(input, -1);
  764.                     if (ch == EOF) error(errsyntaxerror);
  765.                     if (ch == '\n') continue;
  766.                     if (ch == 'n') ch = '\n';
  767.                     if (ch == 'r') ch = '\r';
  768.                     if (ch == 't') ch = '\t';
  769.                     if (ch == 'b') ch = '\b';
  770.                     if (ch == 'f') ch = '\f';
  771.                     num = digitval(ch);
  772.                     if (num < 8)
  773.                     {   ch = readch(input, -1);
  774.                         dig = digitval(ch);
  775.                         if (dig < 8)
  776.                         {   num = num * 8 + dig;
  777.                             ch = readch(input, -1);
  778.                             dig = digitval(ch);
  779.                             if (dig < 8)
  780.                                 num = num * 8 + dig;
  781.                             else
  782.                                 unreadch(input, ch);
  783.                         }
  784.                         else
  785.                             unreadch(input, ch);
  786.                         ch = num;
  787.                     }
  788.                 }
  789.                 *vmstring(length++, 1) = ch;
  790.             }
  791. str:        if (length > 65535) error(errlimitcheck);
  792.             token->type = typestring;
  793.             token->flags = 0;
  794.             token->length = length;
  795.             token->value.vref = vmalloc(length);
  796.             return 1;
  797.  
  798.         case '<':
  799.             length = 0;
  800.             for (;;)
  801.             {   do
  802.                     ch = readch(input, -1);
  803.                     while (ch == ' ' || ch == '\t' || ch == '\n');
  804.                 if ((num = digitval(ch)) >= 16)
  805.                 {   if (ch == '>')
  806.                         break;
  807.                     else
  808.                         error(errsyntaxerror);
  809.                 }
  810.                 do
  811.                     ch = readch(input, -1);
  812.                     while (ch == ' ' || ch == '\t' || ch == '\n');
  813.                 if ((dig = digitval(ch)) >= 16)
  814.                 {   if (ch == '>')
  815.                         dig = 0;
  816.                     else
  817.                         error(errsyntaxerror);
  818.                 }
  819.                 *vmstring(length++, 1) = (num << 4) + dig;
  820.                 if (ch == '>') break;
  821.             }
  822.             goto str;
  823.  
  824.         case '{':
  825.             if (depth >= maxdepth) error(errlimitcheck);
  826.             nest = opernest;
  827.             for (;;)
  828.             {   ch = readch(input, depth);
  829.                 if (ch == EOF) error(errsyntaxerror);
  830.                 if (ch == ' ' || ch == '\t' || ch == '\n') continue;
  831.                 if (ch == '%')
  832.                 {   for (;;)
  833.                     {   ch = readch(input, depth);
  834.                         if (ch == EOF) error(errsyntaxerror);
  835.                         if (ch == '\n') break;
  836.                     }
  837.                     continue;
  838.                 }
  839.                 if (ch == '}') break;
  840.                 unreadch(input, ch);
  841.                 if (opernest == operstacksize) error(errstackoverflow);
  842.                 if (!scantoken(&operstack[opernest++], input, depth + 1))
  843.                     error(errsyntaxerror);
  844.             }
  845.             token->length = length = opernest - nest;
  846.             if (packing)
  847.             {   token->type = typepacked;
  848.                 token->flags = flagexec | flagwprot;
  849.                 token->value.vref = arraypack(&operstack[nest], length);
  850.             }
  851.             else
  852.             {   token->type = typearray;
  853.                 token->flags = flagexec;
  854.                 token->value.vref = arrayalloc(length);
  855.                 arraycopy(vmaptr(token->value.vref),
  856.                           &operstack[nest], length);
  857.             }
  858.             opernest = nest;
  859.             return 1;
  860.  
  861.         case '}':
  862.             error(errsyntaxerror);
  863.  
  864.         case '[':
  865.         case ']':
  866.             namebuf[0] = ch;
  867.             nametoken(token, namebuf, 1, flagexec);
  868.             return 1;
  869.  
  870.         default:
  871.             flags = flagexec;
  872.             load = 0;
  873.             if (ch == '/')
  874.             {   flags = 0;
  875.                 ch = readch(input, depth);
  876.                 if (ch == '/')
  877.                 {   load = 1;
  878.                     ch = readch(input, depth);
  879.                 }
  880.             }
  881.             length = 0;
  882.             for (;;)
  883.             {   switch (ch)
  884.                 {   case EOF:
  885.                     case '%':
  886.                     case '(': case ')': case '<': case '>':
  887.                     case '[': case ']': case '{': case '}':
  888.                     case '/':
  889.                         unreadch(input, ch);
  890.                     case ' ': case '\t': case '\n':
  891.                         break;
  892.  
  893.                     default:
  894.                         if (length == namebufsize) error(errlimitcheck);
  895.                         namebuf[length++] = ch;
  896.                         ch = readch(input, depth);
  897.                         continue;
  898.                 }
  899.                 break;
  900.             }
  901.             namebuf[length] = ' ';
  902.             if (flags == flagexec)
  903.                 if (numtoken(token, namebuf)) return 1;
  904.             nametoken(token, namebuf, length, flags);
  905.             if (load)
  906.                 if (dictfind(token, token) == -1) error(errundefined);
  907.             return 1;
  908.     }
  909. }
  910.  
  911. /* Make a number token if we can */
  912.  
  913. int numtoken(struct object *token, char *string)
  914. {   char *sptr = string;
  915.     int ch, dig, num;
  916.     unsigned int base, limit;
  917.     int sign = 0, ovf = 0, digits = 0;
  918.     limit = 0x7fffffff;
  919.     ch = *sptr++;
  920.     if      (ch == '+')
  921.     {   sign = 1;
  922.         ch = *sptr++;
  923.     }
  924.     else if (ch == '-')
  925.     {   sign = 2;
  926.         ch = *sptr++;
  927.         limit = 0x80000000;
  928.     }
  929.     if (ch == '.') goto decn;
  930.     num = digitval(ch);
  931.     if (num >= 10) return 0;
  932.     digits = 1;
  933.     for (;;)
  934.     {   ch = *sptr++;
  935.         dig = digitval(ch);
  936.         if (dig >= 10) break;
  937.         if (num > limit/10 - 1)
  938.             if ((dig > limit%10) || (num > limit/10)) ovf = 1;
  939.         num = num * 10 + dig;
  940.     }
  941.  
  942.     if (ch != '#') goto decn;
  943.     ch = *sptr++;
  944.  
  945.     if (sign != 0 || num == 0 || num > 36) return 0;
  946.     limit = 0xffffffff;
  947.     base = num;
  948.     num = digitval(ch);
  949.     if (num >= base) return 0;
  950.     for (;;)
  951.     {   ch = *sptr++;
  952.         dig = digitval(ch);
  953.         if (dig >= base) break;
  954.         if (num > limit/base - 1)
  955.             if ((dig > limit%base) || (num > limit/base)) ovf = 1;
  956.         num = num * base + dig;
  957.     }
  958.     if (ch != ' ') return 0;
  959.     if (ovf == 0) goto numi;
  960.     error(errlimitcheck);
  961.  
  962. decn:
  963.     if (ch == '.')
  964.     {   ovf = 1;
  965.         for (;;)
  966.         {   ch = *sptr++;
  967.             dig = digitval(ch);
  968.             if (dig >= 10) break;
  969.             digits = 1;
  970.         }
  971.     }
  972.     if (digits == 0) return 0;
  973.     if (ch == 'E' || ch == 'e')
  974.     {   ovf = 1;
  975.         digits = 0;
  976.         ch = *sptr++;
  977.         if (ch == '+' || ch == '-') ch = *sptr++;
  978.         for (;;)
  979.         {   dig = digitval(ch);
  980.             if (dig >= 10) break;
  981.             digits = 1;
  982.             ch = *sptr++;
  983.         }
  984.         if (digits == 0) return 0;
  985.     }
  986.     if (ch != ' ') return 0;
  987.     if (ovf == 0) goto numi;
  988.  
  989.     token->type = typereal;
  990.     token->flags = 0;
  991.     token->length = 0;
  992.     token->value.rval = (double) atof(string);
  993.     return 1;
  994.  
  995. numi:
  996.     token->type = typeint;
  997.     token->flags = 0;
  998.     token->length = 0;
  999.     token->value.ival = (sign == 2)? -num: num;
  1000.     return 1;
  1001. }
  1002.  
  1003. /* Make a name token by looking up its string in the name table */
  1004.  
  1005. void nametoken(struct object *token, char *string, int length, int flags)
  1006. {   struct name *nameptr;
  1007.     vmref *nameslot, nameref;
  1008.     char *s;
  1009.     unsigned int hash = 0;
  1010.  
  1011.     if (length < 0) length = strlen(string);
  1012.     s = string + length;
  1013.     while (s != string) hash = hash * 12345 + *--s;
  1014.  
  1015.     nameslot = &nametable[hash % nametablesize];
  1016.     for (;;)
  1017.     {   nameref = *nameslot;
  1018.         if (nameref == 0) break;
  1019.         nameptr = vmnptr(nameref);
  1020.         if (nameptr->hash == hash &&
  1021.             nameptr->length == length &&
  1022.             memcmp(nameptr->string, string, length) == 0)
  1023.             goto lab;
  1024.         nameslot = &nameptr->chain;
  1025.     }
  1026.  
  1027.     nameref = vmalloc(sizeof (struct name) - 2 + length);
  1028.     nameptr = vmnptr(nameref);
  1029.     nameptr->chain = 0;
  1030.     nameptr->hash = hash;
  1031.     nameptr->length = length;
  1032.     memcpy(nameptr->string, string, length);
  1033.     *nameslot = nameref;
  1034.  
  1035. lab:
  1036.     token->type = typename;
  1037.     token->flags = flags;
  1038.     token->length = 0;
  1039.     token->value.vref = nameref;
  1040. }
  1041.  
  1042. /* Create a new dictionary token */
  1043.  
  1044. void dicttoken(struct object *token, int size)
  1045. {   struct dictionary *dict;
  1046.     vmref dref;
  1047.     int length, slots, p, i;
  1048.  
  1049.     /* Table of primes. */
  1050.  
  1051.     static int primes[] =
  1052.         {  3,   5,   7,  11,  13,  17,  19,  23,  29,  31,
  1053.           37,  41,  43,  47,  53,  59,  61,  67,  71,  73,
  1054.           79,  83,  89,  97, 101, 103, 107, 109, 113, 127,
  1055.          131, 137, 139, 149, 151, 157, 163, 167, 173, 179,
  1056.          181, 191, 193, 197, 199, 211, 223, 227, 229, 233,
  1057.          239, 241, 251, 257
  1058.         };
  1059.  
  1060.     /* Choose the number of hash table slots.  Make it an odd number about
  1061.      * 1.25 times the dictionary size, with at least one unused slot (so
  1062.      * the search always terminates). */
  1063.  
  1064.     if (size < 0) error(errrangecheck);
  1065.     slots = size + size/4 + 1 | 1;
  1066.  
  1067.     /* Round the number up to the next prime. */
  1068.  
  1069. lab:
  1070.     if (slots > 65535) error(errlimitcheck);
  1071.     for (i = 0; p = primes[i], p * p <= slots ; i++)
  1072.         if (slots % p == 0)
  1073.         {   slots += 2;
  1074.             goto lab;
  1075.         }
  1076.  
  1077.     /* Now create the dictionary. */
  1078.  
  1079.     length = (sizeof (struct dictionary)) +
  1080.               sizeof (struct dictentry) * (slots - 1);
  1081.     dref = vmalloc(length);
  1082.     dict = vmdptr(dref);
  1083.     dict->type = typedict;
  1084.     dict->flags = 0;
  1085.     dict->slots = slots;
  1086.     dict->size = size;
  1087.     dict->full = 0;
  1088.     dict->saved = vmnest;
  1089.     dict->length = length;
  1090.     token->type = typedict;
  1091.     token->flags = 0;
  1092.     token->length = 0;
  1093.     token->value.vref = dref;
  1094. }
  1095.  
  1096. /* Put the value of a key into a dictionary */
  1097.  
  1098. void dictput(vmref dref, struct object *key, struct object *val)
  1099. {   struct dictionary *dict;
  1100.     union dictkey lkey, ekey;
  1101.     struct vmlist *vmlist;
  1102.     vmref vmlref, *vmlslot;
  1103.     unsigned int hash, slot;
  1104.  
  1105.     dict = vmdptr(dref);
  1106.     if (dict->flags & flagwprot) error(errinvalidaccess);
  1107.  
  1108.     /* Convert strings to names */
  1109.  
  1110.     if (key->type == typenull)
  1111.         error(errtypecheck);
  1112.     if (key->type == typestring)
  1113.         nametoken(&lkey.keyobj, vmsptr(key->value.vref), key->length, 0);
  1114.     else
  1115.     {   lkey.keyobj = *key;
  1116.         lkey.keyobj.flags = 0;
  1117.     }
  1118.  
  1119.     /* If we have not saved the dictionary since the last vm save, we must
  1120.      * save it now. */
  1121.  
  1122.     if (dict->saved < vmnest)
  1123.     {   vmlslot = &(vmstack[vmnest].hlist[vmhashsize]);
  1124.         vmlref = vmalloc(sizeof (struct vmlist) + dict->length);
  1125.         vmlist = vmvptr(vmlref);
  1126.         vmlist->chain = *vmlslot;
  1127.         vmlist->vref = dref;
  1128.         vmlist->length = dict->length;
  1129.         memcpy((char *) (vmlist + 1), (char *) dict, dict->length);
  1130.         *vmlslot = vmlref;
  1131.         dict->saved = vmnest;
  1132.     }
  1133.  
  1134.     /* Compute the hash value.  If we need to rehash we add the hash value
  1135.      * modulo the table size.  Since the size is a prime number this will
  1136.      * scan the entire table - unless the hash value is zero when we add
  1137.      * one instead. */
  1138.  
  1139.     slot = (lkey.keyint[0] * 2 + lkey.keyint[1]) % dict->slots;
  1140.     hash = slot;
  1141.     if (hash == 0) hash = 1;
  1142.  
  1143.     /* Search the table for the key, or an empty slot.  Then insert. */
  1144.  
  1145.     for (;;)
  1146.     {   ekey.keyobj = dict->entries[slot].key;
  1147.         if (ekey.keyobj.type == 0)
  1148.         {   if (dict->full == dict->size) error(errdictfull);
  1149.             dict->full++;
  1150.             dict->entries[slot].key = *key;
  1151.             break;
  1152.         }
  1153.         ekey.keyobj.flags = 0;
  1154.         if (ekey.keyint[1] == lkey.keyint[1] &&
  1155.             ekey.keyint[0] == lkey.keyint[0])
  1156.         {   dict->entries[slot].key.flags = key->flags;
  1157.             break;
  1158.         }
  1159.         slot += hash;
  1160.         if (slot >= dict->slots) slot -= dict->slots;
  1161.     }
  1162.     dict->entries[slot].val = *val;
  1163. }
  1164.  
  1165. /* Get the value of a key from a dictionary */
  1166.  
  1167. int dictget(vmref dref, struct object *key, struct object *val, int flags)
  1168. {   struct dictionary *dict;
  1169.     union dictkey lkey, ekey;
  1170.     unsigned int hash, slot;
  1171.  
  1172.     dict = vmdptr(dref);
  1173.     if (dict->flags & flags) error(errinvalidaccess);
  1174.  
  1175.     /* Convert strings to names */
  1176.  
  1177.     if (key->type == typenull)
  1178.         error(errtypecheck);
  1179.     if (key->type == typestring)
  1180.         nametoken(&lkey.keyobj, vmsptr(key->value.vref), key->length, 0);
  1181.     else
  1182.     {   lkey.keyobj = *key;
  1183.         lkey.keyobj.flags = 0;
  1184.     }
  1185.  
  1186.     /* Compute the hash value. */
  1187.  
  1188.     slot = (lkey.keyint[0] * 2 + lkey.keyint[1]) % dict->slots;
  1189.     hash = slot;
  1190.     if (hash == 0) hash = 1;
  1191.  
  1192.     /* Search the table. */
  1193.  
  1194.     for (;;)
  1195.     {   ekey.keyobj = dict->entries[slot].key;
  1196.         if (ekey.keyobj.type == 0)
  1197.             return 0;
  1198.         ekey.keyobj.flags = 0;
  1199.         if (ekey.keyint[1] == lkey.keyint[1] &&
  1200.             ekey.keyint[0] == lkey.keyint[0])
  1201.         {   *val = dict->entries[slot].val;
  1202.             return 1;
  1203.         }
  1204.         slot += hash;
  1205.         if (slot >= dict->slots) slot -= dict->slots;
  1206.     }
  1207. }
  1208.  
  1209. /* Find a key in the dictionary stack */
  1210.  
  1211. int dictfind(struct object *key, struct object *val)
  1212. {   struct dictionary *dict;
  1213.     union dictkey lkey, ekey;
  1214.     unsigned int hash, slot;
  1215.     int nest = dictnest;
  1216.  
  1217.     /* Convert strings to names */
  1218.  
  1219.     if (key->type == typenull)
  1220.         error(errtypecheck);
  1221.     if (key->type == typestring)
  1222.         nametoken(&lkey.keyobj, vmsptr(key->value.vref), key->length, 0);
  1223.     else
  1224.     {   lkey.keyobj = *key;
  1225.         lkey.keyobj.flags = 0;
  1226.     }
  1227.  
  1228.     /* Search all the directories on the stack. */
  1229.  
  1230.     while (nest--)
  1231.     {   dict = vmdptr(dictstack[nest].value.vref);
  1232.         if (dict->flags & flagrprot) error(errinvalidaccess);
  1233.         slot = (lkey.keyint[0] * 2 + lkey.keyint[1]) % dict->slots;
  1234.         hash = slot;
  1235.         if (hash == 0) hash = 1;
  1236.         for (;;)
  1237.         {   ekey.keyobj = dict->entries[slot].key;
  1238.             if (ekey.keyobj.type == 0)
  1239.                 break;
  1240.             ekey.keyobj.flags = 0;
  1241.             if (ekey.keyint[1] == lkey.keyint[1] &&
  1242.                 ekey.keyint[0] == lkey.keyint[0])
  1243.             {   *val = dict->entries[slot].val;
  1244.                 return nest;
  1245.             }
  1246.             slot += hash;
  1247.             if (slot >= dict->slots) slot -= dict->slots;
  1248.         }
  1249.     }
  1250.     return -1;
  1251. }
  1252.  
  1253. /* Pack an array */
  1254.  
  1255. vmref arraypack(struct object *aptr, int length)
  1256. {   char *sptr;
  1257.     int len = 0;
  1258.     while (length--)
  1259.     {   sptr = vmstring(len, sizeof (struct object));
  1260.         len += pack(aptr++, sptr);
  1261.     }
  1262.     return vmalloc(len);
  1263. }
  1264.  
  1265. /* Unpack an array */
  1266.  
  1267. void arrayunpk(struct object *aptr, char *sptr, int length)
  1268. {   while (length--) sptr += unpack(aptr++, sptr);
  1269. }
  1270.  
  1271. /* Pack the next element of an array */
  1272.  
  1273. int pack(struct object *token, char *sptr)
  1274. {   int type = token->type;
  1275.     int flags = token->flags;
  1276.     sptr[0] = type | flags;
  1277.     switch (type)
  1278.     {   case typenull:
  1279.         case typemark:
  1280.             return 1;
  1281.  
  1282.         case typesave:
  1283.         case typefile:
  1284.             sptr[1] = token->length;
  1285.             memcpy(sptr + 2, (char *) &token->value, sizeof token->value);
  1286.             return 2 + sizeof token->value;
  1287.  
  1288.         case typeoper:
  1289.         case typebool:
  1290.             sptr[1] = token->value.ival;
  1291.             return 2;
  1292.  
  1293.         case typeint:
  1294.             if (token->value.ival >= -32 && token->value.ival < 224)
  1295.             {   sptr[0] = typechar | flags;
  1296.                 sptr[1] = token->value.ival + 32;
  1297.                 return 2;
  1298.             }
  1299.         case typefont:
  1300.         case typereal:
  1301.         case typename:
  1302.         case typedict:
  1303.         case typeoper2:
  1304.             memcpy(sptr + 1, (char *) &token->value, sizeof token->value);
  1305.             return 1 + sizeof token->value;
  1306.  
  1307.         case typearray:
  1308.         case typepacked:
  1309.         case typestring:
  1310.             memcpy(sptr + 1, (char *) &token->length,
  1311.                    sizeof token->length + sizeof token->value);
  1312.             return 1 + sizeof token->length + sizeof token->value;
  1313.     }
  1314. }
  1315.  
  1316. /* Unpack the next element of an array */
  1317.  
  1318. int unpack(struct object *token, char *sptr)
  1319. {   int type = ((unsigned char *) sptr)[0];
  1320.     token->flags = type & 0xf0;
  1321.     token->type = type = type & 0x0f;
  1322.     switch (type)
  1323.     {   case typenull:
  1324.         case typemark:
  1325.             token->length = 0;
  1326.             token->value.ival = 0;
  1327.             return 1;
  1328.  
  1329.         case typesave:
  1330.         case typefile:
  1331.             token->length = ((unsigned char *) sptr)[1];
  1332.             memcpy((char *) &token->value, sptr + 2, sizeof token->value);
  1333.             return 2 + sizeof token->value;
  1334.  
  1335.         case typeoper:
  1336.         case typebool:
  1337.             token->length = 0;
  1338.             token->value.ival = ((unsigned char *) sptr)[1];
  1339.             return 2;
  1340.  
  1341.         case typeoper2:
  1342.             token->type = typeoper;
  1343.         case typeint:
  1344.         case typefont:
  1345.         case typereal:
  1346.         case typename:
  1347.         case typedict:
  1348.             token->length = 0;
  1349.             memcpy((char *) &token->value, sptr + 1, sizeof token->value);
  1350.             return 1 + sizeof token->value;
  1351.  
  1352.         case typearray:
  1353.         case typepacked:
  1354.         case typestring:
  1355.             memcpy((char *) &token->length, sptr + 1,
  1356.                    sizeof token->length + sizeof token->value);
  1357.             return 1 + sizeof token->length + sizeof token->value;
  1358.  
  1359.         case typechar:
  1360.             token->type = typeint;
  1361.             token->length = 0;
  1362.             token->value.ival = ((unsigned char *) sptr)[1] - 32;
  1363.             return 2;
  1364.     }
  1365. }
  1366.  
  1367. /* Initialise the virtual machine */
  1368.  
  1369. void vminit(int parms)
  1370. {   vmnest = 0;
  1371.     vmsegno = vmparms = parms;
  1372.     vmsegsize = memvmin;
  1373.     if (vmsegsize > 0x1000000) vmsegsize = 0x1000000;
  1374.     vmused = 0;
  1375.     vmhwm = 0;
  1376.     vmmax = vmsegsize * (vmsegmax - vmparms);
  1377.     memset((char *) &vmbeg, 0, sizeof vmbeg);
  1378.     memset((char *) &vmnext, 0, sizeof vmnext);
  1379.     memset((char *) &vmsize, 0, sizeof vmsize);
  1380.     memset((char *) vmstack, 0, sizeof vmstack);
  1381.     packing = 0;
  1382. }
  1383.  
  1384. /* Tidy up the virtual machine */
  1385.  
  1386. void vmtidy(void)
  1387. {   while (vmsegno >= vmparms)
  1388.     {   memfree(vmbeg[vmsegno], vmsize[vmsegno]);
  1389.         vmsegno--;
  1390.     }
  1391. }
  1392.  
  1393. /* Set up a virtual machine parameter segment */
  1394.  
  1395. void vmparm(int parm, void *beg, int size)
  1396. {   vmbeg[parm] = beg;
  1397.     vmsize[parm] = vmnext[parm] = size;
  1398. }
  1399.  
  1400. /* Allocate some memory in the virtual machine */
  1401.  
  1402. vmref vmalloc(int size)
  1403. {   vmref vref;
  1404.     int blksize = (size + (mcalign - 1)) & ~(mcalign - 1);
  1405.     if (blksize > vmsize[vmsegno] - vmnext[vmsegno])
  1406.         vmallocseg(blksize, 0);
  1407.     vref = vmxref(vmsegno, vmnext[vmsegno]);
  1408.     vmnext[vmsegno] += blksize;
  1409.     vmused += blksize;
  1410.     if (vmused > vmhwm) vmhwm = vmused;
  1411.     return vref;
  1412. }
  1413.  
  1414. /* Allocate some memory in the virtual machine */
  1415.  
  1416. void *vmallocv(int size)
  1417. {   vmref vref = vmalloc(size);
  1418.     return vmvptr(vref);
  1419. }
  1420.  
  1421. /* Convert a virtual machine reference to an address */
  1422.  
  1423. void *vmxptr(vmref vref)
  1424. {   return vmvptr(vref);
  1425. }
  1426.  
  1427. /* Preallocate space for a string at the end of the virtual machine memory */
  1428.  
  1429. char *vmstring(int length, int size)
  1430. {   int blksize = length + size;
  1431.     if (blksize > vmsize[vmsegno] - vmnext[vmsegno])
  1432.         vmallocseg(blksize, length);
  1433.     return vmbeg[vmsegno] + vmnext[vmsegno] + length;
  1434. }
  1435.  
  1436. /* Allocate a new virtual machine memory segment */
  1437.  
  1438. void vmallocseg(int blksize, int length)
  1439. {   char *vbeg;
  1440.     int segsize, numsegs;
  1441.     numsegs = (blksize + vmsegsize - 1) / vmsegsize;
  1442.     segsize = vmsegsize * numsegs;
  1443.     if (vmsegno + numsegs >
  1444.             vmsegmax + (vmnext[vmsegno] == 0 ? 1 : 0)) error(errVMerror);
  1445.     vbeg = memalloc(segsize);
  1446.     if (vbeg == NULL) error(errmemoryallocation);
  1447.     memcpy(vbeg, vmbeg[vmsegno] + vmnext[vmsegno], length);
  1448.     if (vmnext[vmsegno] == 0)
  1449.     {   memfree(vmbeg[vmsegno], vmsize[vmsegno]);
  1450.         vmsegno--;
  1451.     }
  1452.     else
  1453.         vmused += vmsize[vmsegno] - vmnext[vmsegno];
  1454.     while (numsegs--)
  1455.     {   vmsegno++;
  1456.         if (numsegs == 0)
  1457.         {   vmbeg[vmsegno] = vbeg;
  1458.             vmsize[vmsegno] = segsize;
  1459.         }
  1460.         else
  1461.         {   vmbeg[vmsegno] = NULL;
  1462.             vmsize[vmsegno] = 0;
  1463.         }
  1464.         vmnext[vmsegno] = 0;
  1465.     }
  1466. }
  1467.  
  1468. /* Save some virtual machine memory before updating it */
  1469.  
  1470. void vmsavemem(vmref vref, int length)
  1471. {   struct vmframe *vmframe;
  1472.     struct vmlist *vmlist;
  1473.     vmref vmlref, *vmlslot;
  1474.     unsigned int hash;
  1475.  
  1476.     vmframe = &vmstack[vmnest];
  1477.  
  1478.     /* We don't need to save it if it is more recent than the last save */
  1479.  
  1480.     if (vmscheck(vmframe, vref)) return;
  1481.  
  1482.     /* Compute the hash value */
  1483.  
  1484.     hash = vref % vmhashsize;
  1485.  
  1486.     /* Look on the hash chain to see if we have saved it already */
  1487.  
  1488.     vmlslot = &(vmframe->hlist[hash]);
  1489.     vmlref = *vmlslot;
  1490.     while (vmlref)
  1491.     {   vmlist = vmvptr(vmlref);
  1492.         if (vmlist->vref == vref && vmlist->length >= length)
  1493.             return;
  1494.         vmlref = vmlist->chain;
  1495.     }
  1496.  
  1497.     /* If we cannot find it save a copy and add it to the list */
  1498.  
  1499.     vmlref = vmalloc(sizeof (struct vmlist) + length);
  1500.     vmlist = vmvptr(vmlref);
  1501.     vmlist->chain = *vmlslot;
  1502.     vmlist->vref = vref;
  1503.     vmlist->length = length;
  1504.     memcpy((char *) (vmlist + 1), vmsptr(vref), length);
  1505.     *vmlslot = vmlref;
  1506. }
  1507.  
  1508. /* Save the virtual machine */
  1509.  
  1510. void vmsave(struct object *token)
  1511. {   struct vmframe *vmframe;
  1512.     if (istate.flags & intgraph) error(errundefined);
  1513.     if (vmnest == vmstacksize || gnest == gstacksize) error(errlimitcheck);
  1514.     gsave();
  1515.     vmframe = &vmstack[vmnest];
  1516.     token->type = typesave;
  1517.     token->flags = 0;
  1518.     token->length = vmnest;
  1519.     token->value.ival = vmframe->generation;
  1520.     vmnest++;
  1521.     vmframe++;
  1522.     vmframe->generation++;
  1523.     vmframe->gnest = gnest;
  1524.     vmframe->packing = packing;
  1525.     vmframe->vsegno = vmsegno;
  1526.     vmframe->vnext = vmnext[vmsegno];
  1527.     vmframe->vused = vmused;
  1528.     memset((char *)vmframe->hlist, 0, sizeof vmframe->hlist);
  1529. }
  1530.  
  1531. /* Restore the virtual machine */
  1532.  
  1533. void vmrest(int nest, int generation)
  1534. {   struct vmframe *vmframe;
  1535.     int vsegno, vnext, vused;
  1536.     if (istate.flags & intgraph) error(errundefined);
  1537.     if (nest < istate.vmbase ||
  1538.         nest >= vmnest ||
  1539.             (generation != -1 && generation != vmstack[nest].generation))
  1540.         error(errinvalidrestore);
  1541.     vmframe = &vmstack[nest + 1];
  1542.  
  1543.     /* Check the stacks */
  1544.  
  1545.     vmrestcheck(vmframe, operstack, opernest);
  1546.     vmrestcheck(vmframe, execstack, execnest);
  1547.     vmrestcheck(vmframe, dictstack, dictnest);
  1548.  
  1549.     gnest = vmframe->gnest;
  1550.     packing = vmframe->packing;
  1551.     vsegno = vmframe->vsegno;
  1552.     vnext = vmframe->vnext;
  1553.     vused = vmframe->vused;
  1554.  
  1555.     /* Restore file and name tables, the font cache, and the memory */
  1556.  
  1557.     vmrestfiles(nest);
  1558.     vmrestnames(vmframe);
  1559.     vmrestfont(vmframe);
  1560.     vmrestmem(nest);
  1561.  
  1562.     /* Clear the memory we have freed */
  1563.  
  1564.     memset(vmbeg[vsegno] + vnext, 0, vmnext[vsegno] - vnext);
  1565.     while (vmsegno > vsegno)
  1566.     {   memfree(vmbeg[vmsegno], vmsize[vmsegno]);
  1567.         vmsegno--;
  1568.     }
  1569.     vmnext[vmsegno] = vnext;
  1570.     vmused = vused;
  1571.  
  1572.     /* Restore the graphics state */
  1573.  
  1574.     grest();
  1575. }
  1576.  
  1577. /* Check a stack for objects refering to memory we are recovering */
  1578.  
  1579. void vmrestcheck(struct vmframe *vmframe,
  1580.                  struct object *stackptr, int stackcnt)
  1581. {   while (stackcnt--)
  1582.     {   if (stackptr->type == typestring ||
  1583.             stackptr->type == typearray ||
  1584.             stackptr->type == typepacked ||
  1585.             stackptr->type == typedict)
  1586.             if (vmscheck(vmframe, stackptr->value.vref))
  1587.                 error(errinvalidrestore);
  1588.         stackptr++;
  1589.     }
  1590. }
  1591.  
  1592. /* Restore the file table */
  1593.  
  1594. void vmrestfiles(int nest)
  1595. {   struct file *file = &filetable[3];
  1596.     int num = 3;
  1597.     while (num < filetablesize)
  1598.     {   if (file->open != 0 && file->saved > nest)
  1599.         {   fclose(file->fptr);
  1600.             file->fptr = NULL;
  1601.             file->generation++;
  1602.             file->open = 0;
  1603.         }
  1604.         file++;
  1605.         num++;
  1606.     }
  1607. }
  1608.  
  1609. /* Restore the name table */
  1610.  
  1611. void vmrestnames(struct vmframe *vmframe)
  1612. {   vmref *nslot1, *nslot2, nref;
  1613.     int i;
  1614.     nslot1 = &nametable[0];
  1615.     i = nametablesize;
  1616.  
  1617.     /* Scan each hash chain.  Unlink all the names more recent than the
  1618.      * save (the tail of the chain). */
  1619.  
  1620.     while (i--)
  1621.     {   nslot2 = nslot1;
  1622.         for (;;)
  1623.         {   nref = *nslot2;
  1624.             if (nref == 0)
  1625.                break;
  1626.             if (vmscheck(vmframe, nref))
  1627.             {   *nslot2 = 0;
  1628.                 break;
  1629.             }
  1630.             nslot2 = &(vmnptr(nref)->chain);
  1631.         }
  1632.         nslot1++;
  1633.     }
  1634. }
  1635.  
  1636. /* Restore the saved memory */
  1637.  
  1638. void vmrestmem(int nest)
  1639. {   struct vmframe *vmframe;
  1640.     struct vmlist *vmlist;
  1641.     vmref vmlref, *vmlslot;
  1642.     int i;
  1643.  
  1644.     vmframe = &vmstack[vmnest];
  1645.  
  1646.     do
  1647.     {   vmlslot = &(vmframe->hlist[0]);
  1648.         i = vmhashsize + 1;
  1649.         while (i--)
  1650.         {   vmlref = *vmlslot++;
  1651.             while (vmlref)
  1652.             {   vmlist = vmvptr(vmlref);
  1653.                 memcpy(vmsptr(vmlist->vref),
  1654.                        (char *)(vmlist + 1), vmlist->length);
  1655.                 vmlref = vmlist->chain;
  1656.             }
  1657.         }
  1658.         vmframe--;
  1659.         vmnest--;
  1660.     }   while (vmnest > nest);
  1661. }
  1662.  
  1663. /* Convert an object to a string */
  1664.  
  1665. int cvstring(struct object *token, char *sptr, int length)
  1666. {   struct name *nptr;
  1667.     char *buf;
  1668.     int len;
  1669.     switch (token->type)
  1670.     {   case typeint:
  1671.             buf = namebuf;
  1672.             len = sprintf(buf, "%d", token->value.ival);
  1673.             break;
  1674.  
  1675.         case typereal:
  1676.             buf = namebuf;
  1677.             len = sprintf(buf, "%g", token->value.rval);
  1678.             if (strchr(buf, '.') == NULL) buf[len++] = '.';
  1679.             break;
  1680.  
  1681.         case typebool:
  1682.             if (token->value.ival)
  1683.                 buf = "true";
  1684.             else
  1685.                 buf = "false";
  1686.             goto str;
  1687.  
  1688.         case typestring:
  1689.             if (token->flags & flagrprot) error(errinvalidaccess);
  1690.             len = token->length;
  1691.             buf = vmsptr(token->value.vref);
  1692.             break;
  1693.  
  1694.         case typename:
  1695.             nptr = vmnptr(token->value.vref);
  1696.             len = nptr->length;
  1697.             buf = nptr->string;
  1698.             break;
  1699.  
  1700.         case typeoper:
  1701.             buf = optable[token->value.ival].sptr;
  1702.             goto str;
  1703.  
  1704.         default:
  1705.             buf = "--nostringval--";
  1706. str:        len = strlen(buf);
  1707.     }
  1708.     if (len > length) error(errrangecheck);
  1709.     if (sptr != buf) memcpy(sptr, buf, len);
  1710.     return len;
  1711. }
  1712.  
  1713. /* Print an object in "=" style */
  1714.  
  1715. void printequals(FILE *fptr, struct object *token)
  1716. {   char *sptr;
  1717.     int length;
  1718.     if (token->type == typestring)
  1719.     {   if (token->flags & flagrprot)
  1720.         {   putstr(fptr, "--nostringval--");
  1721.             return;
  1722.         }
  1723.         length = token->length;
  1724.         sptr = vmsptr(token->value.vref);
  1725.     }
  1726.     else
  1727.         length = cvstring(token, sptr = namebuf, namebufsize);
  1728.     putmem(fptr, sptr, length);
  1729. }
  1730.  
  1731. /* Print an object in "==" style */
  1732.  
  1733. void printeqeq(FILE *fptr, struct object *token, int depth, int count)
  1734. {   struct object upelem, *element;
  1735.     char *sptr;
  1736.     int length;
  1737.     if (count != 0) putch(fptr, ' ');
  1738.     switch (token->type)
  1739.     {   case typenull:
  1740.         case typemark:
  1741.         case typesave:
  1742.         case typefile:
  1743.         case typedict:
  1744.         case typefont:
  1745. type:       putch(fptr, '-');
  1746.             putstr(fptr, typetable[token->type]);
  1747.             putch(fptr, '-');
  1748.             break;
  1749.  
  1750.         case typeoper:
  1751.             putstr(fptr, "--");
  1752.             putstr(fptr, optable[token->value.ival].sptr);
  1753.             putstr(fptr, "--");
  1754.             break;
  1755.  
  1756.         case typearray:
  1757.             if (!(token->flags & flagrprot) && depth < maxdepth)
  1758.             {   putch(fptr, (token->flags & flagexec) ? '{' : '[');
  1759.                 length = token->length;
  1760.                 element = vmaptr(token->value.vref);
  1761.                 while (length--)
  1762.                     printeqeq(fptr, element++, depth+1, ++count);
  1763.                 putch(fptr, ' ');
  1764.                 putch(fptr, (token->flags & flagexec) ? '}' : ']');
  1765.                 break;
  1766.             }
  1767.             goto type;
  1768.  
  1769.         case typepacked:
  1770.             if (!(token->flags & flagrprot) && depth < maxdepth)
  1771.             {   putch(fptr, (token->flags & flagexec) ? '{' : '[');
  1772.                 length = token->length;
  1773.                 sptr = vmsptr(token->value.vref);
  1774.                 while (length--)
  1775.                 {   sptr += unpack(&upelem, sptr);
  1776.                     printeqeq(fptr, &upelem, depth+1, ++count);
  1777.                 }
  1778.                 putch(fptr, ' ');
  1779.                 putch(fptr, (token->flags & flagexec) ? '}' : ']');
  1780.                 break;
  1781.             }
  1782.             goto type;
  1783.  
  1784.         case typestring:
  1785.             if (!(token->flags & flagrprot))
  1786.             {   putch(fptr, '(');
  1787.                 putcheck(fptr, vmsptr(token->value.vref), token->length);
  1788.                 putch(fptr, ')');
  1789.                 break;
  1790.             }
  1791.             goto type;
  1792.  
  1793.         case typename:
  1794.             if (!(token->flags & flagexec)) putch(fptr, '/');
  1795.         default:
  1796.             length = cvstring(token, namebuf, namebufsize);
  1797.             putcheck(fptr, namebuf, length);
  1798.             break;
  1799.     }
  1800. }
  1801.  
  1802. /* Test two objects for equality */
  1803.  
  1804. int equal(struct object *token1, struct object *token2)
  1805. {   struct object tokn1 = *token1, tokn2 = *token2;
  1806.     struct name *nptr;
  1807.     char *buf1, *buf2;
  1808.     if (tokn1.type == typeint && tokn2.type == typeint)
  1809.         return tokn1.value.ival == tokn2.value.ival;
  1810.     if (tokn1.type == typeint)
  1811.     {   tokn1.type = typereal;
  1812.         tokn1.value.rval = tokn1.value.ival;
  1813.     }
  1814.     if (tokn2.type == typeint)
  1815.     {   tokn2.type = typereal;
  1816.         tokn2.value.rval = tokn2.value.ival;
  1817.     }
  1818.     if (tokn1.type == typereal && tokn2.type == typereal)
  1819.         return tokn1.value.rval == tokn2.value.rval;
  1820.     if ((tokn1.flags & flagrprot) || (tokn2.flags & flagrprot))
  1821.             error(errinvalidaccess);
  1822.     if (tokn1.type == typestring)
  1823.         buf1 = vmsptr(tokn1.value.vref);
  1824.     if (tokn2.type == typestring)
  1825.         buf2 = vmsptr(tokn2.value.vref);
  1826.     if (tokn1.type == typename)
  1827.     {   nptr = vmnptr(tokn1.value.vref);
  1828.         tokn1.type = typestring;
  1829.         tokn1.length = nptr->length;
  1830.         buf1 = &nptr->string[0];
  1831.     }
  1832.     if (tokn2.type == typename)
  1833.     {   nptr = vmnptr(tokn2.value.vref);
  1834.         tokn2.type = typestring;
  1835.         tokn2.length = nptr->length;
  1836.         buf2 = &nptr->string[0];
  1837.     }
  1838.     if (tokn1.type == typestring && tokn2.type == typestring)
  1839.     {   if (tokn1.length != tokn2.length) return 0;
  1840.         return (memcmp(buf1, buf2, tokn1.length) == 0);
  1841.     }
  1842.     if (tokn1.type == tokn2.type &&
  1843.         tokn1.length == tokn2.length &&
  1844.         tokn1.value.ival == tokn2.value.ival)
  1845.         return 1;
  1846.     return 0;
  1847. }
  1848.  
  1849. /* Compare two objects */
  1850.  
  1851. int compare(struct object *token1, struct object *token2)
  1852. {   struct object tokn1 = *token1, tokn2 = *token2;
  1853.     unsigned char *sptr1, *sptr2;
  1854.     int length;
  1855.     if (tokn1.type == typeint && tokn2.type == typeint)
  1856.     {   if      (tokn1.value.ival == tokn2.value.ival)
  1857.             return  0;
  1858.         else if (tokn1.value.ival < tokn2.value.ival)
  1859.             return -1;
  1860.         else
  1861.             return  1;
  1862.     }
  1863.     if (tokn1.type == typeint)
  1864.     {   tokn1.type = typereal;
  1865.         tokn1.value.rval = tokn1.value.ival;
  1866.     }
  1867.     if (tokn2.type == typeint)
  1868.     {   tokn2.type = typereal;
  1869.         tokn2.value.rval = tokn2.value.ival;
  1870.     }
  1871.     if (tokn1.type == typereal && tokn2.type == typereal)
  1872.     {   if      (tokn1.value.rval == tokn2.value.rval)
  1873.             return  0;
  1874.         else if (tokn1.value.rval < tokn2.value.rval)
  1875.             return -1;
  1876.         else
  1877.             return  1;
  1878.     }
  1879.     if (tokn1.type == typestring && tokn2.type == typestring)
  1880.     {   if ((tokn1.flags & flagrprot) || (tokn2.flags & flagrprot))
  1881.             error(errinvalidaccess);
  1882.         length = (tokn1.length < tokn2.length) ?
  1883.                   tokn1.length : tokn2.length;
  1884.         sptr1 = (unsigned char *) vmsptr(tokn1.value.vref);
  1885.         sptr2 = (unsigned char *) vmsptr(tokn2.value.vref);
  1886.         while (length--)
  1887.         {   if (*sptr1 != *sptr2)  return (*sptr1 - *sptr2);
  1888.             sptr1++;
  1889.             sptr2++;
  1890.         }
  1891.         return (tokn1.length - tokn2.length);
  1892.     }
  1893.     error(errtypecheck);
  1894.     return 0;
  1895. }
  1896.  
  1897.  
  1898. /* Bind a procedure */
  1899.  
  1900. void bind(struct object *proc, int depth)
  1901. {   struct object token, *aptr;
  1902.     char *sptr;
  1903.     int length, len;
  1904.     length = proc->length;
  1905.  
  1906.     /* Array.  If not write protected, save it and scan looking up executable
  1907.      * names and replacing them if they are operators.  Recurse for embedded
  1908.      * procedures */
  1909.  
  1910.     if (proc->type == typearray)
  1911.     {   if (proc->flags & flagwprot) return;
  1912.         aptr = vmaptr(proc->value.vref);
  1913.         arraysave(proc->value.vref, length);
  1914.         while (length--)
  1915.         {   if (aptr->flags & flagexec)
  1916.                 if      (aptr->type == typename)
  1917.                 {   if (dictfind(aptr, &token) != -1)
  1918.                         if (token.type == typeoper) *aptr = token;
  1919.                 }
  1920.                 else if (aptr->type == typearray || aptr->type == typepacked)
  1921.                 {   if (depth == maxdepth) error(errlimitcheck);
  1922.                     bind(aptr, depth + 1);
  1923.                     aptr->flags |= flagwprot;
  1924.                 }
  1925.             aptr++;
  1926.         }
  1927.     }
  1928.  
  1929.     /* Packed array.  First unpack it to calculate the length to save.  Then
  1930.      * scan it unpacking sequentially.  Replace names with oper2 (same size).
  1931.      * Repack any elements we update */
  1932.  
  1933.     else
  1934.     {   sptr = vmsptr(proc->value.vref);
  1935.         len = 0;
  1936.         while (length--)
  1937.             len += unpack(&token, sptr + len);
  1938.         vmsavemem(proc->value.vref, len);
  1939.         length = proc->length;
  1940.         while (length--)
  1941.         {   len = unpack(&token, sptr);
  1942.             if (token.flags & flagexec)
  1943.                 if      (token.type == typename)
  1944.                 {   if (dictfind(&token, &token) != -1)
  1945.                         if (token.type == typeoper)
  1946.                         {   token.type = typeoper2;
  1947.                             pack(&token, sptr);
  1948.                         }
  1949.                 }
  1950.                 else if (token.type == typearray || token.type == typepacked)
  1951.                 {   if (depth == maxdepth) error(errlimitcheck);
  1952.                     bind(&token, depth + 1);
  1953.                     token.flags |= flagwprot;
  1954.                     pack(&token, sptr);
  1955.                 }
  1956.             sptr += len;
  1957.         }
  1958.     }
  1959. }
  1960.  
  1961. /* Estimate user (elapsed) time in milliseconds */
  1962.  
  1963. int usertime(void)
  1964. {   time(&time2);
  1965.     return (time2 - time1) * 1000;
  1966. }
  1967.  
  1968. /* Stop */
  1969.  
  1970. void stop(void)
  1971. {   struct object token, *token1;
  1972.     int nest = execnest;
  1973.     token1 = &execstack[nest];
  1974.  
  1975.     /* Search the execution stack for a "stopped".  Long jump if we find
  1976.      * one.  Close "run" files as we go. */
  1977.  
  1978.     while (nest)
  1979.     {   token1--;
  1980.         if      (token1->flags & flagrun)
  1981.             fileclose(token1 - 1);
  1982.         else if (token1->flags & flagstop)
  1983.         {   if (opernest == operstacksize) error(errstackoverflow);
  1984.             token.type = typebool;
  1985.             token.flags = 0;
  1986.             token.length = 0;
  1987.             token.value.ival = 1;
  1988.             operstack[opernest++] = token;
  1989.             execnest = nest - 2;
  1990.             errorjmp(token1->length, 1);
  1991.         }
  1992.         nest--;
  1993.     }
  1994. }
  1995.  
  1996. /* Error routine */
  1997.  
  1998. void error(int errnum)
  1999. {   struct object token;
  2000.     int nest;
  2001.  
  2002.     errornum = errnum;
  2003.     errorstring = errortable[errornum];
  2004.  
  2005.     /* Error during initialisation */
  2006.  
  2007.     if (errorflag == 0)
  2008.         nest = 0;
  2009.  
  2010.     /* Error trapping enabled */
  2011.  
  2012.     else
  2013.     {   flushlevel(0);
  2014.  
  2015.         /* Save the error name and command in memory */
  2016.  
  2017.         errdstoken[edserrorname] = errorname[errnum];
  2018.         errdstoken[edserrorname].flags = 0;
  2019.         errdstoken[edscommand] = *currtoken;
  2020.  
  2021.         /* If we are not already in the error handler, save the stacks too,
  2022.          * and call it if we can (and not killed) */
  2023.  
  2024.         if (errorflag == 2)
  2025.         {   errorflag = 1;
  2026.             errorarray(&token, operstack, opernest);
  2027.             errdstoken[edsostack] = token;
  2028.             errorarray(&token, execstack, execnest);
  2029.             errdstoken[edsestack] = token;
  2030.             errorarray(&token, dictstack, dictnest);
  2031.             errdstoken[edsdstack] = token;
  2032.             if (errnum != errkill)
  2033.             {   if (execnest < execstacksize &&
  2034.                     dictget(errordict.value.vref, &errorname[errnum],
  2035.                             &token, 0))
  2036.                 {   execstack[execnest++] = token;
  2037.                     errorflag = 2;
  2038.                 }
  2039.             }
  2040.         }
  2041.  
  2042.         /* Otherwise return to interactive or quit */
  2043.  
  2044.         if (errorflag != 2)
  2045.         {   errorflag = 2;
  2046.             errorexit();
  2047.             errormsg();
  2048.             nest = 0;
  2049.         }
  2050.         else
  2051.             nest = inest;
  2052.     }
  2053.  
  2054.     errorjmp(nest, 1);
  2055. }
  2056.  
  2057. /* Error save array, if there is enough memory */
  2058.  
  2059. void errorarray(struct object *token1, struct object *aptr, int length)
  2060. {   struct object token;
  2061.     if (vmused + length * sizeof (struct object) <= vmmax)
  2062.     {   token.type = typearray;
  2063.         token.flags = 0;
  2064.         token.length = length;
  2065.         token.value.vref = arrayalloc(length);
  2066.         arraycopy(vmaptr(token.value.vref), aptr, length);
  2067.     }
  2068.     else
  2069.     {   token.type = typenull;
  2070.         token.flags = 0;
  2071.         token.length = 0;
  2072.         token.value.ival = 0;
  2073.     }
  2074.     *token1 = token;
  2075. }
  2076.  
  2077. /* Error return to interactive mode or exit */
  2078.  
  2079. void errorexit(void)
  2080. {   struct file *file;
  2081.     FILE *fptr;
  2082.     if (prompting)
  2083.     {   execnest = 1;
  2084.         file = &filetable[0];
  2085.         file->emode = 0;
  2086.         fptr = file->fptr;
  2087.         while (file->ch != EOF && file->ch != '\n')
  2088.             file->ch = getf(file, fptr);
  2089.     }
  2090.     else
  2091.     {   execnest = 0;
  2092.         returncode = 10;
  2093.     }
  2094. }
  2095.  
  2096. /* Print an error message */
  2097.  
  2098. void errormsg(void)
  2099. {   if (sstderr)
  2100.     {   putstr(sstderr, "post: error: ");
  2101.         printequals(sstderr, &errdstoken[edserrorname]);
  2102.         putstr(sstderr, ", command ");
  2103.         printeqeq(sstderr, &errdstoken[edscommand], 0, 0);
  2104.         putch(sstderr, '\n');
  2105.     }
  2106. }
  2107.  
  2108. /* Long jump to the error jump buffer */
  2109.  
  2110. void errorjmp(int nest, int num)
  2111. {   while (nest < inest)
  2112.     {   if (istate.pfcrec)
  2113.             istate.pfcrec->count = 0;
  2114.         istate = istack[--inest];
  2115.     }
  2116.     longjmp(istate.errjmp, num);
  2117. }
  2118.  
  2119. /* End of file "postint.c" */
  2120.